home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
wildcat
/
wc30rec.zip
/
BTREEU.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-05-12
|
5KB
|
158 lines
function SwitchLast(Name : Str25) : Str25;
var
X, Y : Byte;
begin
Y := Length(Name);
X := Y;
while (Y > 0) and (Name[Y] <> ' ') do
Dec(Y);
if (Y = 0) then
SwitchLast := Name
else
SwitchLast := Copy(Name, Succ(Y), X-Y)+' '+Copy(Name, 1, Pred(Y));
end;
function BuildUserKey(var Data; KeyNr : Byte) : IsamKeyStr;
var
UserRec : UserRecordType absolute Data;
begin
case KeyNr of
UserNameKey : BuildUserKey := Pack6BitKeyUC(SwitchLast(UserRec.UserName), 19);
UserSecKey : BuildUserKey := Pack6BitKeyUC(UserRec.SecLevel, 8)+Pack6BitKeyUC(SwitchLast(UserRec.UserName), 19);
UserExpDateKey : BuildUserKey := WordToKey(UserRec.ExpireDate);
UserAliasKey : if UserRec.Alias = '' then
BuildUserKey := ''
else
BuildUserKey := Pack6BitKeyUC(UserRec.Alias, 19);
end;
end;
function AddUserRecord(var UserRec : UserRecordType) : Boolean;
var
Key : IsamKeyStr;
KeyNr : Byte;
RefNr : LongInt;
LockStatus : Boolean;
begin
LockStatus := LockBTree(dbUser);
FindBtreeKey(UserFile, RefNr, BuildUserKey(UserRec, UserNameKey), UserNameKey);
if not IsamOk then
begin
BtAddRec(UserFile, RefNr, UserRec);
if not IsamOk then
LogFatalError('Unable to add user record', IsamError);
for KeyNr := 1 to KeysDatabase[dbUser] do
begin
Key := BuildUserKey(UserRec, KeyNr);
if Key <> '' then
begin
BtAddKey(UserFile, KeyNr, RefNr, Key);
if not IsamOk then
LogFatalError('Unable to add user key #'+Long2Str(KeyNr), IsamError);
end;
end;
AddUserRecord := True;
end
else
AddUserRecord := False;
if LockStatus then
UnLockBtree(dbUser);
end;
function DeleteUserRecord(var UserRec : UserRecordType) : Boolean;
var
Key : IsamKeyStr;
KeyNr : Byte;
RefNr : LongInt;
LockStatus : Boolean;
begin
LockStatus := LockBTree(dbUser);
FindBtreeKey(UserFile, RefNr, BuildUserKey(UserRec, UserNameKey), UserNameKey);
if IsamOk then
begin
GetBtreeRec(UserFile, RefNr, UserRec);
if not IsamOk then
LogFatalError('Unable to load user record on delete', IsamError);
for KeyNr := 1 to KeysDatabase[dbUser] do
begin
Key := BuildUserKey(UserRec, KeyNr);
if Key <> '' then
begin
BtDeleteKey(UserFile, KeyNr, RefNr, BuildUserKey(UserRec, KeyNr));
if not IsamOk then
LogFatalError('Unable to delete user key', IsamError);
end;
end;
BtDeleteRec(UserFile, RefNr);
if not IsamOK then
LogFatalError('Unable to delete user record', IsamError);
DeleteUserRecord := True;
end
else
DeleteUserRecord := False;
if LockStatus then
UnLockBtree(dbUser);
end;
function UpdateUserRecord(var UserRec : UserRecordType; PrevName : Str25) : Boolean;
label
ExitPoint;
var
KeyNr : Byte;
RefNr : LongInt;
Key : IsamKeyStr;
LockStatus : Boolean;
PrevUser : UserRecordType;
begin
UpdateUserRecord := False;
PrevUser.UserName := PrevName;
LockStatus := LockBTree(dbUser);
if (PrevName <> UserRec.UserName) and UserInDataBase(UserRec.UserName, RefNr) then
goto ExitPoint;
FindBtreeKey(UserFile, RefNr, BuildUserKey(PrevUser, UserNameKey), UserNameKey);
if IsamOk then
begin
GetBtreeRec(UserFile, RefNr, PrevUser);
if not IsamOk then
LogFatalError('Unable to load user record on update', IsamError);
for KeyNr := 1 to KeysDatabase[dbUser] do
begin
Key := BuildUserKey(PrevUser, KeyNr);
if (Key <> '') and (Key <> BuildUserKey(UserRec, KeyNr)) then
begin
BtDeleteKey(UserFile, KeyNr, RefNr, Key);
if not IsamOk then
LogFatalError('Unable to delete user key #'+Long2Str(KeyNr), IsamError);
end;
end;
Move(PrevUser.Confs, UserRec.Confs, SizeOf(ConfUserArray));
BtPutRec(UserFile, RefNr, UserRec, False);
if not IsamOk then
LogFatalError('Unable to update user record', IsamError);
for KeyNr := 1 to KeysDatabase[dbUser] do
begin
Key := BuildUserKey(UserRec, KeyNr);
if (Key <> '') and (Key <> BuildUserKey(PrevUser, KeyNr)) then
begin
BtAddKey(UserFile, KeyNr, RefNr, Key);
if not IsamOK then
LogFatalError('Unable to add user key', IsamError);
end;
end;
UpdateUserRecord := True;
end;
ExitPoint:
if LockStatus then
UnLockBtree(dbUser);
end;